home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HPAVC
/
HPAVC CD-ROM.iso
/
MYMUD21.ZIP
/
MMUD21.ZIP
/
SOURCE
/
SOURCE.ZIP
/
NORM_DO.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-01-21
|
34KB
|
1,149 lines
{$I COPYRGHT.INC}
(*---------------------------------------------------------------------------*
This unit contains all the normal functions which are available in the game.
*---------------------------------------------------------------------------*)
Unit Norm_do;
Interface
Uses Dos,
Header,
MyIO,
VerbList,
LowLevel,
Misc,
Multi,
BoolExpr,
BIN_DB,
Out_proc;
(*---------------------------------------------------------------------------*
Do_Look_At gives the description of the current room OR of the object
the user is looking at:
Look - Current room
Look at Tree - Description of the tree
Look at me - Description of the user self
Look here - Description of the current room
*---------------------------------------------------------------------------*)
Function Do_Look_At(Current : ContextType; InpStr : String):Boolean;
(*---------------------------------------------------------------------------*
Gives some inside info about object.
*---------------------------------------------------------------------------*)
Procedure Do_Examine(Current : ContextType;InpStr : String);
(*---------------------------------------------------------------------------*
Do_Inventory shows the names of all object is the Object.contents chain
which have the TYPE_THING flag set.
*---------------------------------------------------------------------------*)
Procedure Do_Inventory(Current : ContextType);
(*---------------------------------------------------------------------------*
HandledMoveFail will be set if a command is accepted as a movement, but
evaluated false.
Can_move detects if the given InpStr contains a legal movement.
Do_move does the actual move
Do_Go_Home moves the player to his/her/its home.
*---------------------------------------------------------------------------*)
Var HandledMoveFail : Boolean;
ExitNr : Integer;
Function Can_Move(Current : ContextType;InpStr : String):Boolean;
Procedure Do_Move(Var Current : ContextType);
Procedure Do_Go_Home(Var Current : ContextType;Talk : Boolean);
(*---------------------------------------------------------------------------*
Do_Get moves a given object from the room to the contents-list of the
player
Do_Drop Moves a give object from the player to the room's contents-list.
*---------------------------------------------------------------------------*)
Procedure Do_Get(Current : ContextType;
InpStr : String);
Procedure Do_Drop(Current : ContextType;
InpStr : String);
(*---------------------------------------------------------------------------*
Do_WhosOn show's a list of users which are loggen in.
*---------------------------------------------------------------------------*)
Procedure Do_WhosOn;
(*---------------------------------------------------------------------------*
Do_Say sends a tekst to all the other users in the same room
*---------------------------------------------------------------------------*)
Procedure Do_Say(Current : ContextType;InpStr : String);
Procedure Do_Whisper(Current : ContextType;InpStr : String);
(*---------------------------------------------------------------------------*
Do_Score shows the user the amound of pennies he/she/it has.
*---------------------------------------------------------------------------*)
Procedure Do_Score(Current : ContextType);
(*---------------------------------------------------------------------------*
Do_Rob tries to rob a give user from 1 penny.
*---------------------------------------------------------------------------*)
Procedure Do_Rob(Current : ContextType;InpStr : String);
(*---------------------------------------------------------------------------*
Do_Give Gives money to an other player. Use: PLAYER=<Amount>
*---------------------------------------------------------------------------*)
Procedure Do_Give(Var Current : ContextType;InpStr : String);
(*---------------------------------------------------------------------------*
Try to kill an other player.
*---------------------------------------------------------------------------*)
Procedure Do_Kill(Var Current : ContextType;InpStr : String);
(*---------------------------------------------------------------------------*
Try to page a user
*---------------------------------------------------------------------------*)
Procedure Do_Page(Current : ContextType; InpStr : String);
(*---------------------------------------------------------------------------*
Give long help if available.
*---------------------------------------------------------------------------*)
Procedure Do_Help(InpStr : String);
(*---------------------------------------------------------------------------*
Use a object. This fires up the Macro string.
*---------------------------------------------------------------------------*)
Procedure Do_Use(Current : ContextType;InpStr : String);
Implementation
(*--------------------------------------------------------------------------*)
Function Do_Look_At(Current : ContextType; InpStr : String):Boolean;
Var ObjNr : Integer;
Err : Integer;
Begin
If InpStr=''
Then Begin
Do_Look_At:=True;
Current.DB.ReadObj(Current.Room);
If Current.DB.IsRoom And
(Not Expression(Current.DB.ObjRec.Key,Current))
Then My_WriteLn('You see nothing special.')
Else Current.DB.Describe('You see nothing special.');
Exit;
End;
InpStr:=UpStr(InpStr);
If Pos('AT ',InpStr)=1
Then Delete(InpStr,1,3);
ObjNr := Str2ObjNr(Current,InpStr);
If ObjNr=Nothing
Then ObjNr:=FussyStr2ObjNr(Current,InpStr);
If (ObjNr=NOTHING)
Then Begin
My_WriteLn('You see nothing special.');
Exit;
End;
Current.DB.ReadObj(ObjNr);
If Current.DB.IsRoom And
(Not Expression(Current.DB.ObjRec.Key,Current))
Then Begin
My_WriteLn('You see nothing special.');
Exit;
End;
If (Current.DB.ObjRec.Location=Current.Room) Or
(Current.DB.ObjRec.Location=Current.Player) Or
(Current.DB.ObjRec.ObjType=Exit_Type) Or
(Current.DB.LevelOk(Wizard_Level))
Then Current.DB.Describe('You see nothing special.')
Else My_WriteLn('You see nothing special.');
End;
(*--------------------------------------------------------------------------*)
Procedure Do_Inventory(Current : ContextType);
Begin
Current.DB.ReadObj(Current.Player);
List_Things(Current.DB.ObjRec.Contents,False);
List_Players(Current,Current.DB.ObjRec.Contents);
{ Since you can''t take players, this shows only drones.. }
End;
(*--------------------------------------------------------------------------*)
Function Can_Move(Current : ContextType;InpStr : String):Boolean;
Var Dum : DataBase;
Tmp : Integer;
Ok : Boolean;
Begin
Can_Move:=False;
Dum.Init;
Dum.ReadObj(Current.Room);
InpStr:=UpStr(InpStr);
Tmp:=Dum.ObjRec.Exits;
{If Tmp=NOTHING
Then Tmp:=Dum.ObjRec.Next;}
Ok:=False;
HandledMoveFail:=False;
While (Tmp<>NOTHING) and (Not OK) Do
Begin
Dum.ReadObj(Tmp);
Ok:=CheckNameList(InpStr,Dum.ObjRec.Name);
If Ok And
Expression(Dum.ObjRec.Key,Current)
Then Begin
Can_Move:=Ok;
ExitNr:=Tmp;
Dum.Final;
Exit;
End
Else Begin
If Ok
Then Begin
Dum.Fail('You can''t go that way.');
TranslateTextMacros(Current.PlayerName,Current.Gender,Dum.TxtRec);
WriteText(Dum.TxtRec);
Dum.OFail(Current.PlayerName+' tries to go to the '+InpStr);
TranslateTextMacros(Current.PlayerName,Current.Gender,Dum.TxtRec);
NotifyAllHere('',Dum.TxtRec);
HandledMoveFail:=True;
End
Else HandledMoveFail:=False;
End;
Tmp:=Dum.ObjRec.Next;
End;
Dum.Final;
End;
(*--------------------------------------------------------------------------*)
Procedure Do_Move(Var Current : ContextType);
Var PrevRoom : Integer;
IsAction : Boolean;
Begin
PrevRoom:=Current.Room;
Current.Room:=ExitNr;
Current.Db.ReadObj(Current.Room);
IsAction:=Current.Db.ObjRec.Location=Current.Db.ObjRec.Exits;
Current.DB.Success('');
TranslateTextMacros(Current.PlayerName,Current.Gender,Current.DB.TxtRec);
If Current.DB.TxtRec[0]<>#00
Then WriteText(Current.DB.TxtRec);
Current.DB.OSuccess('');
TranslateTextMacros(Current.PlayerName,Current.Gender,Current.DB.TxtRec);
If Current.DB.TxtRec[0]<>#00
Then Begin
If IsAction Or (Current.DB.TxtRec[0]<>#00)
Then NotifyAllHere('',Current.DB.TxtRec)
Else NotifyAllHere(Current.PlayerName+' ',Current.DB.TxtRec);
End
Else Begin
If Not IsAction
Then SayToAllHere(Current,' has left.');
End;
Current.Room:=Current.DB.ObjRec.Location;
Current.Db.ReadObj(Current.Room);
MoveTo(Current.Player,Current.Room);
If Not IsAction
Then HandleDrones(ExitNr,Current,PrevRoom);
End;
(*--------------------------------------------------------------------------*)
Procedure Do_Go_Home(Var Current : ContextType;Talk : Boolean);
Var OldRoom : Integer;
Begin
OldRoom:=Current.Room;
Lock('Updating guest..');
Current.DB.ReadObj(Current.Player);
Current.Room:=Current.DB.ObjRec.Exits;
If UpStr(Current.PlayerName)<>'GUEST'
Then Begin
If Talk
Then Begin
My_WriteLn('');
My_WriteLn('There''s no place like home...');
My_WriteLn('There''s no place like home...');
My_WriteLn('There''s no place like home...');
My_WriteLn('You wake up back home, without your possessions..');
SayToAllHere(Current,' goes home..');
End;
End
Else Begin
Current.DB.ObjRec.Pennies:=0;
Current.DB.updateObj(Current.Player);
End;
MoveTo(Current.Player,Current.Room);
HandleDrones(0,Current,OldRoom);
Unlock;
End;
(*--------------------------------------------------------------------------*)
Procedure Do_Get(Current : ContextType;
InpStr : String);
Var ObjNr : Integer;
Dum : Database;
Begin
If InpStr=''
Then Begin
My_WriteLn('What??');
Exit;
End;
ObjNr:=ObjectIsHere(Current,InpStr);
If ObjNr=NOTHING
Then Begin
My_WriteLn('There is no '+InpStr+' to get here!');
Exit;
End;
Lock('Taking an object');
Current.DB.ReadObj(ObjNr);
If (ObjNr<>NOTHING) and
(Current.DB.ObjRec.Location=Current.Player)
Then Begin
My_WriteLn('You already have '+Current.DB.Name);
Unlock;
Exit;
End;
If (ObjNr<>NOTHING) And
(Current.DB.IsExit or Current.DB.IsRoom or Current.DB.IsPlayer)
Then Begin
Current.DB.Fail('You can''t take that.');
TranslateTextMacros(Current.PlayerName,Current.Gender,Current.DB.TxtRec);
WriteText(Current.DB.TxtRec);
Current.DB.OFail(Current.PlayerName+' tries to take '+InpStr+' but fails.');
TranslateTextMacros(Current.PlayerName,Current.Gender,Current.DB.TxtRec);
NotifyAllHere('',Current.DB.TxtRec);
Unlock;
Exit;
End;
If (Not Expression(Current.DB.ObjRec.Key,Current))
Then Begin
Current.DB.Fail('You can''t take that.');
TranslateTextMacros(Current.PlayerName,Current.Gender,Current.DB.TxtRec);
WriteText(Current.DB.TxtRec);
Current.DB.OFail(Current.PlayerName+' tries to take '+InpStr+' but fails.');
TranslateTextMacros(Current.PlayerName,Current.Gender,Current.DB.TxtRec);
NotifyAllHere('',Current.DB.TxtRec);
Unlock;
Exit;
End;
If Current.DB.IsForSale
Then Begin
Dum.Init;
Dum.ReadObj(Current.Player);
If (Current.DB.ObjRec.Pennies>Dum.ObjRec.Pennies) and
(Current.Level<Wizard_Level)
Then Begin
My_WriteLn('You can''t afford to buy this object!');
Dum.Final;
Unlock;
Exit;
End
Else Begin
Dec(Dum.ObjRec.Pennies,Current.DB.ObjRec.Pennies);
Dum.UpdateObj(Current.Player);
My_WriteLn('You bought yourself a '+Current.DB.Name+' for only '+
Nr2Str(Current.DB.ObjRec.Pennies)+'p.');
SayToAllHere(Current,' bought a '+Current.DB.Name);
End;
If Current.DB.IsChownOk
Then Current.DB.ObjRec.Owner:=Current.Player;
ResetBit(Current.DB.ObjRec.Attr_Flags,For_Sale_Flag);
Current.DB.UpdateObj(ObjNr);
Dum.Final;
End;
Current.DB.Success('You take '+InpStr);
TranslateTextMacros(Current.PlayerName,Current.Gender,Current.DB.TxtRec);
WriteText(Current.DB.TxtRec);
Current.DB.OSuccess(Current.PlayerName+' takes the '+InpStr);
TranslateTextMacros(Current.PlayerName,Current.Gender,Current.DB.TxtRec);
NotifyAllHere('',Current.DB.TxtRec);
MoveTo(ObjNr,Current.Player);
Current.DB.ResetAll;
Unlock;
End;
(*--------------------------------------------------------------------------*)
Procedure Do_Drop(Current : ContextType;
InpStr : String);
Var ObjNr : Integer;
Reward : Integer;
Dum : Database;
Begin
If InpStr=''
Then Begin
My_WriteLn('What??');
Exit;
End;
ObjNr:=ObjectIsHere(Current,InpStr);
If ObjNr=NOTHING
Then Begin
My_WriteLn('You can''t drop '+InpStr);
Exit;
End;
Lock('Drop object');
Current.DB.ReadObj(ObjNr);
If (Current.DB.ObjRec.Location<>Current.Player)
Then Begin
My_WriteLn('You don''t have '+InpStr);
Unlock;
Exit;
End;
Dum.Init;
Dum.ReadObj(Current.Room);
If Dum.IsTemple
Then Begin
MoveTo(ObjNr,Current.DB.ObjRec.Exits);
My_WriteLn(Current.DB.Name+' is consumed in a burst of flames!');
Reward:=0;
Dum.ReadObj(Current.Player);
Reward:=Current.DB.ObjRec.Pennies;
If Current.DB.IsOwnedBy(Current.Player) Or
Dum.LevelOk(Wizard_level)
Then Begin
If (Reward<1) or
(Dum.ObjRec.Pennies>Max_PENNIES)
Then Reward:=1
Else Begin
If Reward > MAX_OBJECT_ENDOWMENT
Then Reward:=MAX_OBJECT_ENDOWMENT;
End;
End;
Inc(Dum.ObjRec.Pennies,Reward);
Dum.UpdateObj(Current.Player);
If Reward=1
Then My_WriteLn('You have been rewarded 1 penny for your donation!')
Else My_WriteLn('You have been rewarded '+Nr2Str(Reward)+' pennies for your donation.');
Dum.Final;
Unlock;
Exit;
End;
If Dum.IsShop { dum=location }
Then Begin
If Current.DB.IsOwner(Current.Player)
Then Begin
If Current.DB.ObjRec.Pennies>1
Then Reward:=Current.DB.ObjRec.Pennies-1
Else Reward:=1;
End
Else Begin
Reward:=10;
If Current.DB.ObjRec.Pennies<Reward
Then reward:=Current.DB.ObjRec.Pennies;
Reward:=-1*Reward;
End;
Dum.ReadObj(Current.Player);
If Dum.ObjRec.Pennies>Max_PENNIES
Then Reward:=1;
Inc(Dum.ObjRec.Pennies,Reward);
If Dum.ObjRec.Pennies<0
Then Begin
Reward:=Reward+Dum.ObjRec.Pennies;
Dum.ObjRec.Pennies:=0;
End;
If Current.DB.IsSticky
Then MoveTo(ObjNr,Current.DB.ObjRec.Exits)
Else MoveTo(ObjNr,Current.Room);
{ Dum.UpdateObj(Current.Player);}
Current.DB.ResetAll;
Current.DB.ReadObj(ObjNr);
With Current.DB.ObjRec Do
Begin
If Not Current.DB.IsSticky
Then SetBit(Attr_Flags,For_Sale_Flag);
If Pennies<=0
Then Pennies:=5
Else Inc(Pennies,1);
Location:=Current.Room;
Key:='';
{ Owner:=0;}
ObjType:=Thing_Type;
End; {With}
Current.DB.UpdateObj(ObjNr);
Unlock;
If Reward>0
Then My_WriteLn('You sold the '+Current.DB.Name+' for '+Nr2Str(reward)+' pennies.')
Else Begin
My_WriteLn('Since you''re not the owner of this object you are fined');
My_WriteLn(Nr2Str(-1*Reward)+' pennies.');
End;
SayToAllHere(Current,' sold a '+Current.DB.Name);
Dum.Final;
Exit;
End;
{ Nor temple nor shop }
If Current.DB.IsSticky
Then MoveTo(ObjNr,Current.DB.ObjRec.Exits)
Else MoveTo(ObjNr,Current.Room);
My_WriteLn('You drop the '+Current.DB.Name);
SayToAllHere(Current,' drops the '+Current.DB.Name);
Current.DB.ResetAll;
Dum.Final;
Unlock;
End;
(*--------------------------------------------------------------------------*)
Procedure Do_WhosOn;
Var Cnt : Word;
Dum : Database;
Page : Byte;
Begin
Multi.GrabUserList;
Dum.Init;
My_WriteLn('');
My_WriteLn('Node Name Status Last Note');
My_WriteLn('──── ─────────────────── ─────── ───── ───────────────────────────────────');
Page:=0;
Cnt:=1;
Repeat
If NodeList[Cnt].Player>0
Then Begin
Dum.ReadObj(NodeList[Cnt].Player);
My_Write(Nr2FStr(Cnt,4)+' '+MakeStr(Dum.Name,' ',20));
My_Write(LevelNames[Dum.ObjRec.ObjLevel]);
My_Write(' '+MakeTimeString(NodeList[Cnt].Last)+' '+NodeList[Cnt].Note);
My_WriteLn('');
If Page<20
Then Inc(Page)
Else Begin
Page:=0;
If My_YesNo('-- More --','Y')<>'Y'
Then Cnt:=511;
End;
End;
Inc(Cnt);
Until (Cnt>MaxMudNodes);
Dum.Final;
My_WriteLn('');
End;
(*--------------------------------------------------------------------------*)
Procedure Do_Say(Current : ContextType;InpStr : String);
Begin
If InpStr[1]='"'
Then Delete(InpStr,1,1);
Current.DB.ReadObj(Current.Player);
SayToAllHere(Current,' says "'+InpStr+'"');
My_WriteLn('You say "'+InpStr+'"');
End;
Procedure Do_Whisper(Current : ContextType;InpStr : String);
Var Name : NameString;
Msg : String;
NewMsg : String;
ObjNr : Integer;
Count : Byte;
Begin
If Not SplitCommand(InpStr,Name,Msg)
Then Begin
My_WriteLn('Use Whisper <name>=<Msg>');
Exit;
End;
If Current.Level>=Wizard_Level
Then ObjNr:=Current.DB.FindPlayer(Name)
Else ObjNr:=Str2ObjNr(Current,Name);
If ObjNr=NOTHING
Then Begin
My_WriteLn(Name+' isn''t here.');
Exit;
End;
If Not IsAlive(ObjNr)
Then Begin
My_WriteLn(Name+' isn''t playing at the moment.');
Exit;
End;
Current.DB.ReadObj(ObjNr);
If Not Current.DB.IsPlayer
Then Begin
My_WriteLn(Current.DB.Name+' is not a player.');
Exit;
End;
If Current.DB.ObjRec.Location=Current.Room
Then NewMsg:=Current.PlayerName+' whispers: "'+Msg+'"'
Else NewMsg:='From out of nowhere you hear '+Current.PlayerName+' whispering:\n "'+Msg+'"';
If ObjNr=Current.Player
Then Begin
My_WriteLn(NewMsg);
SayToAllHere(Current,' whispers to himself.');
End
Else SayPrivate(ObjNr,NewMsg);
Current.DB.ReadObj(Current.Room);
If (Random(10)<7) And
(Current.DB.IsLoud)
Then Begin
For Count:=1 To (Length(Msg) Div 3) Do
Msg[Random(Length(Msg))+1]:='~';
GeneralRemarkToAllHere('You here someone wispering: '+Msg);
End;
End;
(*--------------------------------------------------------------------------*)
Procedure Do_Score(Current : ContextType);
Begin
Current.DB.ReadObj(Current.Player);
My_WriteLn('Your level is: '+LevelNames[Current.DB.ObjRec.ObjLevel]);
If Current.DB.ObjRec.Pennies=1
Then My_WriteLn('You have 1 penny.')
Else My_WriteLn('You have '+Nr2Str(Current.DB.ObjRec.Pennies)+' pennies.');
End;
(*--------------------------------------------------------------------------*)
Procedure Do_Rob(Current : ContextType;InpStr : String);
Var ObjNr : Integer;
Dum : Database;
Begin
InpStr:=UpStr(inpStr);
Lock('Update pennies');
If InpStr='ME'
Then ObjNr:=Current.Player
Else Begin
Current.DB.ReadObj(Current.Room);
ObjNr:=FindItem(Current.DB.ObjRec.Contents,InpStr);
If (ObjNr=NOTHING)
Then Begin
My_WriteLn('Huh?!');
UnLock;
Exit;
End;
End;
Dum.Init;
Dum.ReadObj(ObjNr);
If Not Dum.IsPlayer
Then Begin
My_WriteLn('You can only rob other players.');
Unlock;
Dum.Final;
Exit;
End;
If Current.Room<>Dum.ObjRec.Location
Then Begin
My_WriteLn(InpStr+' is not here and therefor cannot be robbed.');
Dum.Final;
Unlock;
Exit;
End;
If Dum.ObjRec.Pennies<1
Then Begin
My_WriteLn(Dum.Name+' is pennyless.');
SayToAllHere(Current,' tried to rob '+Dum.Name);
Unlock;
Dum.Final;
Exit;
End;
If Not Expression(Dum.ObjRec.Key,Current)
Then Begin
Dum.Fail(Dum.Name+' is protected agains robbers!');
TranslateTextMacros(Current.PlayerName,Current.Gender,Dum.TxtRec);
WriteText(Dum.TxtRec);
Dum.OFail(Current.PlayerName+' tries foolishly to rob '+Dum.Name+' but fails.');
TranslateTextMacros(Current.PlayerName,Current.Gender,Dum.TxtRec);
NotifyAllHere('',Dum.TxtRec);
End
Else Begin
Dec(Dum.ObjRec.Pennies);
Dum.UpdateObj(ObjNr);
Current.DB.ReadObj(Current.Player);
Inc(Current.DB.ObjRec.Pennies);
Current.DB.UpdateObj(Current.Player);
ResetPlayerObj(ObjNr);
Dum.Success('You got your penny!');
WriteText(Dum.TxtRec);
Dum.OSuccess(Current.PlayerName+' stole a penny from '+dum.Name);
NotifyAllHere('',Dum.TxtRec);
End;
Unlock;
Dum.Final;
End;
(*--------------------------------------------------------------------------*)
Procedure Do_Give(Var Current : ContextType;InpStr : String);
Var Name : NameString;
Pennies : String[20];
Money : Integer;
ObjNr : Integer;
Dum : Database;
Begin
InpStr:=UpStr(InpStr);
If Not SplitCommand(InpStr,Name,Pennies)
Then Begin
My_WriteLn('uh?');
Exit;
End;
ObjNr:=Str2ObjNr(Current,Name);
If ObjNr=NOTHING
Then Begin
My_WriteLn('That player is not here.');
Exit;
End;
If ObjNr=Current.Player
Then Begin
My_WriteLn('Awsome! you murmle to yourself as you give yourself some money.');
Exit;
End;
Lock('Give money');
Current.DB.ReadObj(Current.Player);
Dum.Init;
Dum.ReadObj(ObjNr);
{$IfNDef MakeGod}
If (Not Dum.IsPlayer) Or
(Dum.LevelOk(Wizard_Level))
Then Begin
My_WriteLn('You can only give money to other players.');
Dum.Final;
Unlock;
Exit;
End;
{$EndIf}
If Dum.ObjRec.Location<>Current.Room
Then Begin
My_WriteLn(Dum.Name+' is not here.');
Dum.Final;
Unlock;
Exit;
End;
If Dum.ObjRec.Pennies>MAX_PENNIES
Then Begin
My_WriteLn(Dum.Name+' doesn''t need more pennies.');
Dum.Final;
Unlock;
Exit;
End;
Money:=Str2Nr(Pennies);
If Money<=0
Then Begin
My_WriteLn('You can only give pennies.');
Dum.Final;
Unlock;
Exit;
End;
If (Not Current.DB.LevelOk(Wizard_Level)) And
(Money>Current.DB.ObjRec.Pennies)
Then Begin
My_WriteLn('You can''t afford such a generosity.');
Dum.Final;
Unlock;
Exit;
End
Else Begin
If Not Current.DB.LevelOk(Wizard_Level)
Then Dec(Current.DB.ObjRec.Pennies,Money);
End;
Inc(Dum.ObjRec.Pennies,Money);
Dum.UpdateObj(ObjNr);
Current.DB.UpdateObj(Current.Player);
Unlock;
My_WriteLn('Ok, you just created '+Nr2Str(Money)+' pennies for '+Dum.Name);
SayPrivate(ObjNr,Current.PlayerName+' just created '+Nr2Str(Money)+' pennies for you.');
Dum.Final;
End;
(*--------------------------------------------------------------------------*)
Procedure Do_Kill(Var Current : ContextType;InpStr : String);
Var Name : NameString;
Pennies : String[20];
Money : Integer;
ObjNr : Integer;
Dum : Database;
Begin
InpStr:=UpStr(InpStr);
If Not SplitCommand(InpStr,Name,Pennies)
Then Begin
Name:=InpStr;
Pennies:='10';
End;
ObjNr:=Str2ObjNr(Current,Name);
If ObjNr=NOTHING
Then Begin
My_WriteLn('That player is not here.');
Exit;
End;
Lock('Kill player');
Current.DB.ReadObj(Current.Room);
If Current.DB.IsHaven
Then Begin
My_WriteLn('Sorry, this room is save for killing.');
Dum.Final;
Unlock;
Exit;
End;
Current.DB.ReadObj(Current.Player);
Dum.Init;
Dum.ReadObj(ObjNr);
If (Not Dum.IsPlayer) Or
(Dum.LevelOk(Wizard_Level))
Then Begin
My_WriteLn('You can only kill other players.');
Dum.Final;
Unlock;
Exit;
End;
If Dum.ObjRec.Location<>Current.Room
Then Begin
My_WriteLn(Dum.Name+' is not here.');
Dum.Final;
Unlock;
Exit;
End;
Money:=Str2Nr(Pennies);
If Money<=0
Then Money:=10;
If (Not Current.DB.LevelOk(Wizard_Level)) And
(Money>Current.DB.ObjRec.Pennies)
Then Begin
My_WriteLn('You don''t have enough money.');
Dum.Final;
Unlock;
Exit;
End;
If Not Current.DB.LevelOk(Wizard_Level)
Then Dec(Current.DB.ObjRec.Pennies,Money);
Current.DB.UpdateObj(Current.Player);
If Random(100)<=Money
Then Begin
Inc(Dum.ObjRec.Pennies,50);
MoveTo(ObjNr,Dum.ObjRec.Exits);
ResetPlayerObj(ObjNr);
My_WriteLn('You killed '+Dum.Name);
SayToAllHere(Current,' killed '+Dum.Name);
End
Else Begin
My_WriteLn('You attempt fails.');
SayToAllHere(Current,' tried to kill '+Dum.Name+' but failed.');
End;
Unlock;
Dum.Final;
End;
(*--------------------------------------------------------------------------*)
Procedure Do_Page(Current : ContextType; InpStr : String);
Var ObjNr : Integer;
PlayerNr : Integer;
Begin
If InpStr=''
Then Exit;
ObjNr:=Current.db.FindPlayer(InpStr);
If ObjNr=NOTHING
Then Begin
My_WriteLn('Euh? WHO?');
Exit;
End;
Current.DB.ReadObj(ObjNr);
If Not IsAlive(ObjNr)
Then Begin
My_WriteLn(Current.DB.Name+' is not playing at this moment.');
Exit;
End;
PlayerNr:=ObjNr;
Current.DB.ReadObj(ObjNr);
If Not Current.DB.IsPlayer
Then Begin
My_WriteLn(Current.DB.Name+' is not a player.');
Exit;
End;
Current.DB.ReadObj(Current.DB.ObjRec.Location);
If Current.DB.IsHaven
Then Begin
My_WriteLn('Player is in haven.');
Exit;
End;
Current.DB.ReadObj(Current.Room);
If PlayerNr=Current.Player
Then My_WriteLn(Current.PlayerName+' pages himself from here.')
Else SayPrivate(PlayerNr,Current.PlayerName+' pages you from '+Current.Db.Name);
My_WriteLn('Player paged.');
End;
(*--------------------------------------------------------------------------*)
Procedure Do_Examine(Current : ContextType;InpStr : String);
Var ObjNr : Integer;
Name : String;
Flags : String;
Begin
If InpStr=''
Then exit;
InpStr:=UpStr(InpStr);
ObjNr:=Str2ObjNr(Current,InpStr);
If ObjNr=NOTHING
Then ObjNr:=FussyStr2ObjNr(Current,InpStr);
If ObjNr=NOTHING
Then Begin
My_WriteLn('You don''t see anything special.');
Exit;
End;
Current.DB.ReadObj(ObjNr);
If Current.DB.ObjRec.Owner=NOTHING
Then Begin
My_WriteLn('Hmm, strange.. I can''t say who this belongs to..');
Exit;
End;
If (Current.DB.IsPlayer And
(ObjNr=Current.Player) And
(Not Current.DB.LevelOk(Builder_Level)))
Then Begin
Case Current.Gender Of
Female : My_WriteLn('After carefull examination you find out you are a girly!');
Male : My_WriteLn('After carefull examination you find out you are a Boy!');
Neuter : Begin
My_WriteLn('After carefull examination you find out you are something!');
My_WriteLn('but you''re definitly not a boy nor a girly..');
End;
End; {Case}
Exit;
End;
If (Current.DB.ObjRec.Location=Current.Room) or
(Current.DB.ObjRec.Location=Current.Player) or
(Current.Level>=Builder_Level)
Then Begin
Name:=Current.DB.Name;
Flags:='';
If Current.Db.IsTemple Then Flags:=Flags+'Temple, ';
If Current.Db.IsHaven Then Flags:=Flags+'Haven, ';
If Current.Db.IsShop Then Flags:=Flags+'Shop, ';
If Current.Db.IsLinkOk Then Flags:=Flags+'Linkable, ';
If Current.Db.IsInvisible Then Flags:=Flags+'Invisible, ';
If Current.DB.IsSticky Then Flags:=Flags+'Sticky, ';
If Flags<>''
Then Begin
Dec(Flags[0],2);
Flags:='Flags: '+Flags+'.';
End;
If Current.DB.IsForSale
Then My_WriteLn(Name+' is for sale.')
Else Begin
Current.DB.ReadObj(Current.DB.ObjRec.Owner);
My_WriteLn(Name+' (#'+Nr2Str(ObjNr)+') belongs to '+Current.DB.Name);
My_WriteLn(Flags);
End;
End
Else Begin
Name:=Current.DB.Name;
Current.DB.ReadObj(Current.DB.ObjRec.Owner);
My_WriteLn(Name+' (#'+Nr2Str(ObjNr)+') belongs to '+Current.DB.Name);
End;
{If (Current.DB.ObjRec.Location=Current.Room) or
(Current.DB.ObjRec.Location=Current.Player) or
(Current.DB.LevelOk(Wizard_Level))
Then Begin
Name:=Current.DB.Name;
Current.DB.ReadObj(Current.DB.ObjRec.Owner);
My_WriteLn(Name+' (#'+Nr2Str(ObjNr)+') belongs to '+Current.DB.Name);
End
Else My_WriteLn('That object isn''t here..');}
End;
(*--------------------------------------------------------------------------*)
Procedure Do_Help(InpStr : String);
Var Help : Text;
Line : String;
Stop : Boolean;
Buf : Array[0..2047] of char;
Name : String[8];
Begin
InpStr:=UpStr(CleanUp(InpStr));
If InpStr=''
Then InpStr:='HELP';
If Not ExistFile(TextPath+'HELP.MUD')
Then Assign(Help,HomeDir+'HELP.MUD')
Else Assign(Help,TextPath+'HELP.MUD');
SetTextBuf(Help,Buf);
Reset(Help);
If IoResult<>0
Then Begin
My_WriteLn('Sorry, no help available. Use ? for a list of commands.');
Exit;
End;
Stop:=False;
Repeat
ReadLn(Help,Line);
If Not (Line[1] in [' ','.'])
Then Stop:=Pos(InpStr,Line)=1;
until Eof(Help) Or Stop;
If Eof(Help)
Then Begin
Close(Help);
My_WriteLn('No help available on that subject.');
Exit;
End;
My_WriteLn(Line);
ReadLn(Help,Line);
My_WriteLn(' Syntax: '+Line);
My_WriteLn(' Description:');
Repeat
ReadLn(Help,Line);
If Line[1]='.'
Then My_WriteLn('')
Else My_WriteLn(Line);
Until Eof(Help) Or (CleanUp(Line)='');
Close(Help);
If IoResult<>0 Then ;
End;
(*--------------------------------------------------------------------------*)
Procedure Do_Use(Current : ContextType;InpStr : String);
Var ObjNr : Integer;
Params : Array[1..9] of String[40];
PStr : String;
PCnt : Byte;
PPtr : Byte;
Count : Byte;
Begin
If InpStr=''
Then Begin
My_WriteLn('Syntax: USE <Object>');
Exit;
End;
If SplitCommand(InpStr,InpStr,PStr)
Then Begin
FillChar(Params,SizeOf(Params),#00);
PCnt:=0;
If PStr<>''
Then Begin
Repeat
If Pos(';',PStr)>0
Then Begin
Inc(PCnt);
Params[PCnt]:=Copy(PStr,1,Pos(';',PStr)-1);
Delete(PStr,1,Length(Params[PCnt])+1);
End
Else Begin
Inc(PCnt);
Params[PCnt]:=PStr;
PStr:='';
End;
Until PStr='';
End;
End;
ObjNr:=Str2ObjNr(Current,InpStr);
If ObjNr=NOTHING
Then Begin
My_WriteLn('You don''t have that object.');
Exit;
End;
Current.DB.ReadObj(ObjNr);
If (Current.DB.ObjRec.Macro.Length=0) Or
(Not Expression(Current.DB.ObjRec.Key,Current))
Then Begin
My_WriteLn('Your powers are insufficient to use the object.');
Exit;
End;
MacroString:=Current.DB.Macro;
If MacroString[1]='='
Then Begin
If Str2Nr(MacroString[2])>PCnt
Then Begin
Current.DB.Describe('You need at least '+MacroString[2]+' parameters');
MacroString:='';
Exit;
End;
Delete(MacroString,1,Pos('^',MacroString));
End;
For Count:=1 To PCnt Do
Begin
PPtr:=Pos('%'+Nr2Str(Count),MacroString);
If PPtr>0
Then Begin
Delete(MacroString,PPtr,2);
Insert(Params[Count],MacroString,PPtr);
End;
End;
End;
End.